home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / amigaunits / commodities.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-22  |  14KB  |  566 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. unit commodities;
  18.  
  19. INTERFACE
  20.  
  21. uses exec, inputevent, keymap;
  22.  
  23.  
  24. {    **************
  25.  * Broker stuff
  26.  **************}
  27.  
  28. CONST
  29. {     buffer sizes   }
  30.       CBD_NAMELEN   =  24;
  31.       CBD_TITLELEN  =  40;
  32.       CBD_DESCRLEN  =  40;
  33.  
  34. {     CxBroker errors   }
  35.       CBERR_OK      =  0;        {     No error                         }
  36.       CBERR_SYSERR  =  1;        {     System error , no memory, etc    }
  37.       CBERR_DUP     =  2;        {     uniqueness violation             }
  38.       CBERR_VERSION =  3;        {     didn't understand nb_VERSION     }
  39.  
  40.       NB_VERSION    =  5;        {     Version of NewBroker structure   }
  41.  
  42. Type
  43.   pNewBroker = ^tNewBroker;
  44.   tNewBroker = record
  45.    nb_Version   : Shortint;  {     set to NB_VERSION                }
  46.    nb_Name,
  47.    nb_Title,
  48.    nb_Descr     : STRPTR;
  49.    nb_Unique,
  50.    nb_Flags     : Integer;
  51.    nb_Pri       : Shortint;
  52.    {     new in V5   }
  53.    nb_Port      : pMsgPort;
  54.    nb_ReservedChannel  : Integer;  {     plans for later port sharing     }
  55.   END;
  56.  
  57. CONST
  58. {     Flags for nb_Unique }
  59.       NBU_DUPLICATE  = 0;
  60.       NBU_UNIQUE     = 1;        {     will not allow duplicates        }
  61.       NBU_NOTIFY     = 2;        {     sends CXM_UNIQUE to existing broker }
  62.  
  63. {     Flags for nb_Flags }
  64.         COF_SHOW_HIDE = 4;
  65.  
  66. {    *******
  67.  * cxusr
  68.  *******}
  69.  
  70. {    * Fake data types for system private objects   }
  71. Type
  72.   CxObj = Longint;
  73.   pCxObj = ^CxObj;
  74.   CxMsg = Longint;
  75.   pCXMsg = ^CxMsg;
  76.  
  77.  
  78. CONST
  79. {    ******************************}
  80. {    * Commodities Object Types   *}
  81. {    ******************************}
  82.       CX_INVALID     = 0;     {     not a valid object (probably null)  }
  83.       CX_FILTER      = 1;     {     input event messages only           }
  84.       CX_TYPEFILTER  = 2;     {     filter on message type      }
  85.       CX_SEND        = 3;     {     sends a message                     }
  86.       CX_SIGNAL      = 4;     {     sends a signal              }
  87.       CX_TRANSLATE   = 5;     {     translates IE into chain            }
  88.       CX_BROKER      = 6;     {     application representative          }
  89.       CX_DEBUG       = 7;     {     dumps kprintf to serial port        }
  90.       CX_CUSTOM      = 8;     {     application provids function        }
  91.       CX_ZERO        = 9;     {     system terminator node      }
  92.  
  93. {    ***************}
  94. {    * CxMsg types *}
  95. {    ***************}
  96.       CXM_UNIQUE     = 16;    {     sent down broker by CxBroker()      }
  97. {     Obsolete: subsumed by CXM_COMMAND (below)   }
  98.  
  99. {     Messages of this type rattle around the Commodities input network.
  100.  * They will be sent to you by a Sender object, and passed to you
  101.  * as a synchronous function call by a Custom object.
  102.  *
  103.  * The message port or function entry point is stored in the object,
  104.  * and the ID field of the message will be set to what you arrange
  105.  * issuing object.
  106.  *
  107.  * The Data field will point to the input event triggering the
  108.  * message.
  109.  }
  110.       CXM_IEVENT     = 32;
  111.  
  112. {     These messages are sent to a port attached to your Broker.
  113.  * They are sent to you when the controller program wants your
  114.  * program to do something.  The ID field identifies the command.
  115.  *
  116.  * The Data field will be used later.
  117.  }
  118.       CXM_COMMAND    = 64;
  119.  
  120. {     ID values   }
  121.       CXCMD_DISABLE   = (15);   {     please disable yourself       }
  122.       CXCMD_ENABLE    = (17);   {     please enable yourself        }
  123.       CXCMD_APPEAR    = (19);   {     open your window, if you can  }
  124.       CXCMD_DISAPPEAR = (21);   {     go dormant                    }
  125.       CXCMD_KILL      = (23);   {     go away for good              }
  126.       CXCMD_UNIQUE    = (25);   {     someone tried to create a broker
  127.                                * with your name.  Suggest you Appear.
  128.                                }
  129.       CXCMD_LIST_CHG  = (27);  {     Used by Exchange program. Someone }
  130.                               {     has changed the broker list       }
  131.  
  132. {     return values for BrokerCommand(): }
  133.       CMDE_OK        = (0);
  134.       CMDE_NOBROKER  = (-1);
  135.       CMDE_NOPORT    = (-2);
  136.       CMDE_NOMEM     = (-3);
  137.  
  138. {     IMPORTANT NOTE: for V5:
  139.  * Only CXM_IEVENT messages are passed through the input network.
  140.  *
  141.  * Other types of messages are sent to an optional port in your broker.
  142.  *
  143.  * This means that you must test the message type in your message handling,
  144.  * if input messages and command messages come to the same port.
  145.  *
  146.  * Older programs have no broker port, so processing loops which
  147.  * make assumptions about type won't encounter the new message types.
  148.  *
  149.  * The TypeFilter CxObject is hereby obsolete.
  150.  *
  151.  * It is less convenient for the application, but eliminates testing
  152.  * for type of input messages.
  153.  }
  154.  
  155. {    ********************************************************}
  156. {    * CxObj Error Flags (return values from CxObjError())  *}
  157. {    ********************************************************}
  158.       COERR_ISNULL      = 1;  {     you called CxError(NULL)            }
  159.       COERR_NULLATTACH  = 2;  {     someone attached NULL to my list    }
  160.       COERR_BADFILTER   = 4;  {     a bad filter description was given  }
  161.       COERR_BADTYPE     = 8;  {     unmatched type-specific operation   }
  162.  
  163.  
  164. {    ****************************}
  165. {     Input Expression structure }
  166. {    ****************************}
  167.  
  168.       IX_VERSION        = 2;
  169.  
  170. Type
  171.   pInputXpression = ^tInputXpression;
  172.   tInputXpression = record
  173.    ix_Version,               {     must be set to IX_VERSION  }
  174.    ix_Class    : Byte;       {     class must match exactly   }
  175.  
  176.    ix_Code     : Word;      {     Bits that we want  }
  177.  
  178.    ix_CodeMask : Word;      {     Set bits here to indicate  }
  179.                              {     which bits in ix_Code are  }
  180.                              {     don't care bits.           }
  181.  
  182.    ix_Qualifier: Word;      {     Bits that we want  }
  183.  
  184.    ix_QualMask : Word;      {     Set bits here to indicate  }
  185.                            {     which bits in ix_Qualifier }
  186.                                                    {     are don't care bits        }
  187.  
  188.    ix_QualSame : Word;    {     synonyms in qualifier      }
  189.   END;
  190.  
  191.    IX = tInputXpression;
  192.    pIX = ^IX;
  193.  
  194. CONST
  195. {     QualSame identifiers }
  196.       IXSYM_SHIFT = 1;     {     left- and right- shift are equivalent     }
  197.       IXSYM_CAPS  = 2;     {     either shift or caps lock are equivalent  }
  198.       IXSYM_ALT   = 4;     {     left- and right- alt are equivalent       }
  199.  
  200. {     corresponding QualSame masks }
  201.       IXSYM_SHIFTMASK = (IEQUALIFIER_LSHIFT + IEQUALIFIER_RSHIFT);
  202.       IXSYM_CAPSMASK  = (IXSYM_SHIFTMASK    + IEQUALIFIER_CAPSLOCK);
  203.       IXSYM_ALTMASK   = (IEQUALIFIER_LALT   + IEQUALIFIER_RALT);
  204.  
  205.       IX_NORMALQUALS  = $7FFF;   {     for QualMask field: avoid RELATIVEMOUSE }
  206.  
  207.  
  208. VAR CxBase : pLibrary;
  209.  
  210. FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT;
  211. PROCEDURE AddIEvents(events : pInputEvent);
  212. PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj);
  213. PROCEDURE ClearCxObjError(co : pCxObj);
  214. FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT): pCxObj;
  215. FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj;
  216. FUNCTION CxMsgData(cxm : pCxMsg) : POINTER;
  217. FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT;
  218. FUNCTION CxMsgType(cxm : pCxMsg) : ULONG;
  219. FUNCTION CxObjError(co : pCxObj) : LONGINT;
  220. FUNCTION CxObjType(co : pCxObj) : ULONG;
  221. PROCEDURE DeleteCxObj(co : pCxObj);
  222. PROCEDURE DeleteCxObjAll(co : pCxObj);
  223. PROCEDURE DisposeCxMsg(cxm : pCxMsg);
  224. PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj);
  225. PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj);
  226. PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj);
  227. FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN;
  228. FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN;
  229. FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT;
  230. PROCEDURE RemoveCxObj(co : pCxObj);
  231. PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj);
  232. FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT;
  233. PROCEDURE SetFilter(filter : pCxObj; text : pCHAR);
  234. PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression);
  235. PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent);
  236.  
  237. IMPLEMENTATION
  238.  
  239. FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT;
  240. BEGIN
  241.   ASM
  242.     MOVE.L  A6,-(A7)
  243.     MOVEA.L co,A0
  244.     MOVE.L  tru,D0
  245.     MOVEA.L CxBase,A6
  246.     JSR -042(A6)
  247.     MOVEA.L (A7)+,A6
  248.     MOVE.L  D0,@RESULT
  249.   END;
  250. END;
  251.  
  252. PROCEDURE AddIEvents(events : pInputEvent);
  253. BEGIN
  254.   ASM
  255.     MOVE.L  A6,-(A7)
  256.     MOVEA.L events,A0
  257.     MOVEA.L CxBase,A6
  258.     JSR -180(A6)
  259.     MOVEA.L (A7)+,A6
  260.   END;
  261. END;
  262.  
  263. PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj);
  264. BEGIN
  265.   ASM
  266.     MOVE.L  A6,-(A7)
  267.     MOVEA.L headObj,A0
  268.     MOVEA.L co,A1
  269.     MOVEA.L CxBase,A6
  270.     JSR -084(A6)
  271.     MOVEA.L (A7)+,A6
  272.   END;
  273. END;
  274.  
  275. PROCEDURE ClearCxObjError(co : pCxObj);
  276. BEGIN
  277.   ASM
  278.     MOVE.L  A6,-(A7)
  279.     MOVEA.L co,A0
  280.     MOVEA.L CxBase,A6
  281.     JSR -072(A6)
  282.     MOVEA.L (A7)+,A6
  283.   END;
  284. END;
  285.  
  286. FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT) : pCxObj;
  287. BEGIN
  288.   ASM
  289.     MOVE.L  A6,-(A7)
  290.     MOVE.L  typ,D0
  291.     MOVEA.L arg1,A0
  292.     MOVEA.L arg2,A1
  293.     MOVEA.L CxBase,A6
  294.     JSR -030(A6)
  295.     MOVEA.L (A7)+,A6
  296.     MOVE.L  D0,@RESULT
  297.   END;
  298. END;
  299.  
  300. FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj;
  301. BEGIN
  302.   ASM
  303.     MOVE.L  A6,-(A7)
  304.     MOVEA.L nb,A0
  305.     MOVE.L  error,D0
  306.     MOVEA.L CxBase,A6
  307.     JSR -036(A6)
  308.     MOVEA.L (A7)+,A6
  309.     MOVE.L  D0,@RESULT
  310.   END;
  311. END;
  312.  
  313. FUNCTION CxMsgData(cxm : pCxMsg) : POINTER;
  314. BEGIN
  315.   ASM
  316.     MOVE.L  A6,-(A7)
  317.     MOVEA.L cxm,A0
  318.     MOVEA.L CxBase,A6
  319.     JSR -144(A6)
  320.     MOVEA.L (A7)+,A6
  321.     MOVE.L  D0,@RESULT
  322.   END;
  323. END;
  324.  
  325. FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT;
  326. BEGIN
  327.   ASM
  328.     MOVE.L  A6,-(A7)
  329.     MOVEA.L cxm,A0
  330.     MOVEA.L CxBase,A6
  331.     JSR -150(A6)
  332.     MOVEA.L (A7)+,A6
  333.     MOVE.L  D0,@RESULT
  334.   END;
  335. END;
  336.  
  337. FUNCTION CxMsgType(cxm : pCxMsg) : ULONG;
  338. BEGIN
  339.   ASM
  340.     MOVE.L  A6,-(A7)
  341.     MOVEA.L cxm,A0
  342.     MOVEA.L CxBase,A6
  343.     JSR -138(A6)
  344.     MOVEA.L (A7)+,A6
  345.     MOVE.L  D0,@RESULT
  346.   END;
  347. END;
  348.  
  349. FUNCTION CxObjError(co : pCxObj) : LONGINT;
  350. BEGIN
  351.   ASM
  352.     MOVE.L  A6,-(A7)
  353.     MOVEA.L co,A0
  354.     MOVEA.L CxBase,A6
  355.     JSR -066(A6)
  356.     MOVEA.L (A7)+,A6
  357.     MOVE.L  D0,@RESULT
  358.   END;
  359. END;
  360.  
  361. FUNCTION CxObjType(co : pCxObj) : ULONG;
  362. BEGIN
  363.   ASM
  364.     MOVE.L  A6,-(A7)
  365.     MOVEA.L co,A0
  366.     MOVEA.L CxBase,A6
  367.     JSR -060(A6)
  368.     MOVEA.L (A7)+,A6
  369.     MOVE.L  D0,@RESULT
  370.   END;
  371. END;
  372.  
  373. PROCEDURE DeleteCxObj(co : pCxObj);
  374. BEGIN
  375.   ASM
  376.     MOVE.L  A6,-(A7)
  377.     MOVEA.L co,A0
  378.     MOVEA.L CxBase,A6
  379.     JSR -048(A6)
  380.     MOVEA.L (A7)+,A6
  381.   END;
  382. END;
  383.  
  384. PROCEDURE DeleteCxObjAll(co : pCxObj);
  385. BEGIN
  386.   ASM
  387.     MOVE.L  A6,-(A7)
  388.     MOVEA.L co,A0
  389.     MOVEA.L CxBase,A6
  390.     JSR -054(A6)
  391.     MOVEA.L (A7)+,A6
  392.   END;
  393. END;
  394.  
  395. PROCEDURE DisposeCxMsg(cxm : pCxMsg);
  396. BEGIN
  397.   ASM
  398.     MOVE.L  A6,-(A7)
  399.     MOVEA.L cxm,A0
  400.     MOVEA.L CxBase,A6
  401.     JSR -168(A6)
  402.     MOVEA.L (A7)+,A6
  403.   END;
  404. END;
  405.  
  406. PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj);
  407. BEGIN
  408.   ASM
  409.     MOVE.L  A6,-(A7)
  410.     MOVEA.L cxm,A0
  411.     MOVEA.L headObj,A1
  412.     MOVEA.L returnObj,A2
  413.     MOVEA.L CxBase,A6
  414.     JSR -156(A6)
  415.     MOVEA.L (A7)+,A6
  416.   END;
  417. END;
  418.  
  419. PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj);
  420. BEGIN
  421.   ASM
  422.     MOVE.L  A6,-(A7)
  423.     MOVEA.L headObj,A0
  424.     MOVEA.L co,A1
  425.     MOVEA.L CxBase,A6
  426.     JSR -090(A6)
  427.     MOVEA.L (A7)+,A6
  428.   END;
  429. END;
  430.  
  431. PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj);
  432. BEGIN
  433.   ASM
  434.     MOVE.L  A6,-(A7)
  435.     MOVEA.L headObj,A0
  436.     MOVEA.L co,A1
  437.     MOVEA.L pred,A2
  438.     MOVEA.L CxBase,A6
  439.     JSR -096(A6)
  440.     MOVEA.L (A7)+,A6
  441.   END;
  442. END;
  443.  
  444. FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN;
  445. BEGIN
  446.   ASM
  447.     MOVE.L  A6,-(A7)
  448.     MOVE.L  ansiCode,D0
  449.     MOVEA.L event,A0
  450.     MOVEA.L km,A1
  451.     MOVEA.L CxBase,A6
  452.     JSR -174(A6)
  453.     MOVEA.L (A7)+,A6
  454.     TST.W   D0
  455.     BEQ.B   @end
  456.     MOVEQ   #1,D0
  457.   @end: MOVE.B  D0,@RESULT
  458.   END;
  459. END;
  460.  
  461. FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN;
  462. BEGIN
  463.   ASM
  464.     MOVE.L  A6,-(A7)
  465.     MOVEA.L event,A0
  466.     MOVEA.L ix,A1
  467.     MOVEA.L CxBase,A6
  468.     JSR -204(A6)
  469.     MOVEA.L (A7)+,A6
  470.     TST.W   D0
  471.     BEQ.B   @end
  472.     MOVEQ   #1,D0
  473.   @end: MOVE.B  D0,@RESULT
  474.   END;
  475. END;
  476.  
  477. FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT;
  478. BEGIN
  479.   ASM
  480.     MOVE.L  A6,-(A7)
  481.     MOVEA.L description,A0
  482.     MOVEA.L ix,A1
  483.     MOVEA.L CxBase,A6
  484.     JSR -132(A6)
  485.     MOVEA.L (A7)+,A6
  486.     MOVE.L  D0,@RESULT
  487.   END;
  488. END;
  489.  
  490. PROCEDURE RemoveCxObj(co : pCxObj);
  491. BEGIN
  492.   ASM
  493.     MOVE.L  A6,-(A7)
  494.     MOVEA.L co,A0
  495.     MOVEA.L CxBase,A6
  496.     JSR -102(A6)
  497.     MOVEA.L (A7)+,A6
  498.   END;
  499. END;
  500.  
  501. PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj);
  502. BEGIN
  503.   ASM
  504.     MOVE.L  A6,-(A7)
  505.     MOVEA.L cxm,A0
  506.     MOVEA.L co,A1
  507.     MOVEA.L CxBase,A6
  508.     JSR -162(A6)
  509.     MOVEA.L (A7)+,A6
  510.   END;
  511. END;
  512.  
  513. FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT;
  514. BEGIN
  515.   ASM
  516.     MOVE.L  A6,-(A7)
  517.     MOVEA.L co,A0
  518.     MOVE.L  pri,D0
  519.     MOVEA.L CxBase,A6
  520.     JSR -078(A6)
  521.     MOVEA.L (A7)+,A6
  522.     MOVE.L  D0,@RESULT
  523.   END;
  524. END;
  525.  
  526. PROCEDURE SetFilter(filter : pCxObj; text : pCHAR);
  527. BEGIN
  528.   ASM
  529.     MOVE.L  A6,-(A7)
  530.     MOVEA.L filter,A0
  531.     MOVEA.L text,A1
  532.     MOVEA.L CxBase,A6
  533.     JSR -120(A6)
  534.     MOVEA.L (A7)+,A6
  535.   END;
  536. END;
  537.  
  538. PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression);
  539. BEGIN
  540.   ASM
  541.     MOVE.L  A6,-(A7)
  542.     MOVEA.L filter,A0
  543.     MOVEA.L ix,A1
  544.     MOVEA.L CxBase,A6
  545.     JSR -126(A6)
  546.     MOVEA.L (A7)+,A6
  547.   END;
  548. END;
  549.  
  550. PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent);
  551. BEGIN
  552.   ASM
  553.     MOVE.L  A6,-(A7)
  554.     MOVEA.L translator,A0
  555.     MOVEA.L events,A1
  556.     MOVEA.L CxBase,A6
  557.     JSR -114(A6)
  558.     MOVEA.L (A7)+,A6
  559.   END;
  560. END;
  561.  
  562. END. (* UNIT COMMODITIES *)
  563.  
  564.  
  565.  
  566.